perm filename DISP.F4[1,MUS]1 blob
sn#079064 filedate 1973-12-22 generic text, type T, neo UTF8
00100 SUBROUTINE DISP(ZCAR,ZMOD,ZZI1,ZZI2)
00200 COMMON FREQ(3,0/50,50),FUNC(50),AMP(50),II(1),IJJ(3000)
00300 302 TYPE 303
00400 303 FORMAT(' TYPE 0 OR 1 FOR NO CH OR AMP FUNC'/)
00500 ACCEPT 304,IFUN
00600 304 FORMAT(I)
00700 GO TO (305,306),IFUN+1
00800 306 TYPE 310
00900 310 FORMAT(' NOW AMPLITUDE FUNCTION'/)
01000 CALL GEN(AMP)
01100 GO TO 305
01200 305 TYPE 308
01300 308 FORMAT(' TYPE 1 FOR ANOTHER FUN OR 0'/)
01400 ACCEPT 304,K
01500 IF(K.EQ.1)GO TO 302
01600 MIBASE=99999
01700 MIFREQ=-400
01800 309 TYPE 103
01900 103 FORMAT(' TYPE 0 FOR NO LINES OR N'/)
02000 ACCEPT 104,ND
02100 104 FORMAT (I)
02200 CALL DPYSET(1,IJJ,3000)
02300 CALL CLRPOG(1)
02400 CALL ALINE(-400,300,-200,300)
02500 CALL ALINE(-400,400,-400,300)
02600 CALL DPYBIG(2)
02700 CALL DPYTXT(-380,280,'AMP FUNCTION',3)
02800 CALL DPYTXT(-440,400,'1.0',1)
02900 IY=AMP(1)*100.+300.
03000 IX=-400
03100 CALL AIVECT(IX,IY)
03200 DO 401 I=2,50
03300 IX=IX+4
03400 IY=AMP(I)*100.+300.
03500 401 CALL AVECT(IX,IY)
03600 CALL ALINE(100,300,300,300)
03700 CALL ALINE(100,400,100,300)
03800 CALL DPYTXT(120,280,'INDEX FUNCTION',3)
03900 CALL DPYTXT(60,400,'IDX2',1)
04000 CALL DPYTXT(60,300,'IDX1',1)
04100 IY=AMP(1)*100.+300.
04200 IX=100
04300 CALL AIVECT(IX,IY)
04400 DO 402 I=2,50
04500 IY=FUNC(I)*100.+300.
04600 IX=IX+4
04700 402 CALL AVECT(IX,IY)
04702 CALL DPYBIG(3)
04704 MCAR='CAR='
04706 ENCODE(5,71,NCAR)MCAR
04708 71 FORMAT(A5)
04710 CALL DPYTXT(-400,-300,NCAR,1)
04712 XCAR=ZCAR
04714 ENCODE(5,72,XXCAR)XCAR
04716 72 FORMAT(F5.1)
04718 CALL DPYTXT(-360,-300,XXCAR,1)
04720 MCAR='MOD='
04722 ENCODE(5,71,NCAR)MCAR
04726 CALL DPYTXT(-400,-320,NCAR,1)
04728 XCAR=ZMOD
04730 ENCODE(5,72,XXCAR)XCAR
04734 CALL DPYTXT(-360,-320,XXCAR,1)
04736 MCAR='IDX1='
04738 ENCODE(5,71,NCAR)MCAR
04742 CALL DPYTXT(-400,-340,NCAR,1)
04744 XCAR=ZZI1
04746 ENCODE(5,72,XXCAR)XCAR
04750 CALL DPYTXT(-360,-340,XXCAR,1)
04752 MCAR='IDX2='
04754 ENCODE(5,71,NCAR)MCAR
04756 CALL DPYTXT(-400,-360,NCAR,1)
04758 XCAR=ZZI2
04760 ENCODE(5,72,XXCAR)XCAR
04762 CALL DPYTXT(-360,-360,XXCAR,1)
04900 CALL ALINE(-400,0,100,0)
05000 CALL ALINE(100,0,90,5)
05100 CALL ALINE(100,0,90,-5)
05200 CALL ALINE(-400,250,-400,0)
05300 CALL ALINE(-400,250,-395,240)
05400 CALL ALINE(-400,250,-405,240)
05500 CALL DPYTXT(-480,250,'Amp',1)
05600 CALL DPYBIG(2)
05700 CALL DPYTXT(-480,0,'0 Hz',1)
05800 CALL DPYBIG(3)
05900 CALL DPYTXT(115,0,'Time',1)
06000 IX=-400
06100 IY=-70
06200 M=10
06300 CALL DPYTXT(IX,IY,'F',1)
06400 IX=IX+M
06500 IY=IY-M
06600 CALL DPYTXT(IX,IY,'r',1)
06700 IX=IX+M
06800 IY=IY-M
06900 CALL DPYTXT(IX,IY,'e',1)
07000 IX=IX+M
07100 IY=IY-M
07200 CALL DPYTXT(IX,IY,'q',1)
07300 MAX=FREQ(1,50,1)
07400 DO 200 J=0,MAX
07500 KL=1
07600 50 IF(FREQ(1,J,KL).EQ.99999.)GO TO 100
07700 C IF((FREQ(1,J,KL).EQ.0.0).AND.(FREQ(3,J,KL).EQ.0.0))GO TO 100
07800 IX=ABS(FREQ(1,J,KL))-400.
07900 ZZ=IX
08000 IY=(ZZ+400.)*(-1.)+250.*FREQ(2,J,KL)*AMP(1)
08100 BASE=(ZZ+400.)*(-1.)
08200 IBASE=BASE
08300 IF(MIBASE.GT.IBASE)MIBASE=IBASE
08400 CALL DPYBIG(2)
08500 IF(FREQ(3,J,KL).NE.0.0)GO TO 51
08600 CALL DPYTXT(IX-40,IBASE,'car',1)
08700 GO TO 60
08800 51 MFREQ=FREQ(1,J,KL)
08900 ENCODE(5,52,NFREQ)MFREQ
09000 52 FORMAT(I5)
09100 CALL DPYTXT(IX-60,IBASE,NFREQ,1)
09200 GO TO 60
09300 100 KL=KL+1
09400 IF(KL.GT.50)GO TO 30
09500 GO TO 50
09600 60 CALL AIVECT(IX,IBASE)
09700 IFREQ=IX
09800 IF(MIFREQ.LT.IFREQ)MIFREQ=IFREQ
09900 DO 61 NO=1,25
10000 CALL SVECT(5,0)
10100 61 CALL SIVECT(15,0)
10200 IF(KL.NE.1)IX=IX+(KL-1)*10
10300 CALL AIVECT(IX,IBASE)
10400 IF(IY.LE.IBASE)IY=(IABS(IY)-IABS(IBASE))+IBASE
10500 IF(FREQ(2,J,KL).NE.0.0)CALL AVECT(IX,IY)
10600 30 CONTINUE
10700 NC=1
10750 IFLIP=1
10800 DO 199 KZ=KL+1,50
10900 IF(KL.GT.50)GO TO 199
11000 IF(FREQ(1,J,KZ).EQ.99999.)GO TO 199
11100 IX=IX+10
11200 IY=FREQ(2,J,KZ)*250.*AMP(KZ)+BASE
11300 IF(IY.LE.IBASE)IY=(IABS(IY)-IABS(IBASE))+IBASE
11310 IF(FREQ(1,J,KZ).EQ.0.0)IFLIP=-IFLIP
11320 IF(IFLIP.GT.0)GO TO 2001
11330 CALL AIVECT(IX,IY)
11340 GO TO 2002
11400 2001 CALL AVECT(IX,IY)
11500 2002 IF(ND.EQ.0)GO TO 199
11600 IF(NC.LT.ND)GO TO 102
11700 CALL AVECT(IX,IBASE)
11800 CALL AIVECT(IX,IY)
11900 102 NC=NC+1
12000 IF(NC.GT.ND)NC=1
12100 199 CONTINUE
12200 200 CONTINUE
12300 MIFREQ=MIFREQ+10
12400 MIBASE=MIBASE-10
12500 CALL ALINE(-400,0,MIFREQ,MIBASE)
12600 CALL ALINE(MIFREQ,MIBASE,MIFREQ-2,MIBASE+10)
12700 CALL ALINE(MIFREQ,MIBASE,MIFREQ-10,MIBASE+4)
12800 CALL DPYOUT(1)
12900 TYPE 603
13000 603 FORMAT(' TYPE 0 TO FIN-1 TO CHNG AMP F-OR 2 VERT LINES'/)
13100 ACCEPT 304,N
13200 CALL HYDPOG(1)
13300 GO TO (302,309),N
13400 II(1)=IJJ(2)+2
13500 CALL SAVB(II)
13600 RETURN
13700 END